home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / ptv1n1.arc / CARDFILE.PAS next >
Pascal/Delphi Source File  |  1990-06-08  |  3KB  |  137 lines
  1.  
  2. { Turbo Cardfile }
  3. { Copyright (c) 1989 by Borland International, Inc. }
  4.  
  5. program CardFile;
  6. { Turbo Pascal 5.5 object-oriented example.
  7.   Demonstrates the use of the CARDS unit.
  8.   Refer to OOPDEMOS.DOC for an overview of this program.
  9. }
  10.  
  11. {$S-}
  12. {$M 8192, 65536, 655360}
  13.  
  14. uses Crt, Objects, Forms, Sliders, UNewType, Cards;
  15.  
  16. const
  17.   Signature: Longint = $44524143;
  18.  
  19. var
  20.   F: Form;
  21.   C: CardList;
  22.   S: FStream;
  23.  
  24. procedure Error(Message: String);
  25. begin
  26.   WriteLn(Message, ': ', ParamStr(1));
  27.   Halt(1);
  28. end;
  29.  
  30. procedure ReadCards;
  31. var
  32.   Header: Longint;
  33. begin
  34.   S.Init(ParamStr(1), SOpen, 1024);
  35.   if S.Status <> 0 then Error('Cannot open file');
  36.   S.Read(Header, SizeOf(Longint));
  37.   if Header <> Signature then Error('File format error');
  38.   F.Load(S);
  39.   C.Load(S);
  40.   if S.Status <> 0 then Error('Disk read error');
  41.   S.Done;
  42. end;
  43.  
  44. function EditCards: Boolean;
  45. var
  46.   Ch: Char;
  47.   Start, Stop: Boolean;
  48.  
  49. function EditForm: Boolean;
  50. begin
  51.   Color(ForeColor);
  52.   GotoXY(1, 25);
  53.   Write('  Edit  '#179' F2-Accept  Esc-Cancel');
  54.   ClrEol;
  55.   EditForm := F.Edit = CSave;
  56. end;
  57.  
  58. function Confirm(Message: String): Boolean;
  59. begin
  60.   Color(ForeColor);
  61.   GotoXY(1, 25);
  62.   Write(' ', Message, ' (Y/N)? ');
  63.   ClrEol;
  64.   Confirm := UpCase(ReadChar) = 'Y';
  65. end;
  66.  
  67. begin
  68.   Color(BackColor);
  69.   ClrScr;
  70.   Color(ForeColor);
  71.   GotoXY(1, 1);
  72.   Write(' File ', ParamStr(1));
  73.   ClrEol;
  74.   Start := True;
  75.   Stop := False;
  76.   repeat
  77.     if C.Count = 0 then F.Clear else F.Put(C.CardData^);
  78.     F.Show(Start);
  79.     Color(ForeColor);
  80.     GotoXY(69, 1);
  81.     Write(C.Count: 5, ' Cards');
  82.     GotoXY(1, 25);
  83.     Write(' Browse '#179' '#25'-Next  '#24'-Prev  Enter-Edit  ' +
  84.       'Ins-Insert  Del-Delete  Esc-Exit ');
  85.     ClrEol;
  86.     Ch := ReadChar;
  87.     if (Ch = CEnter) and (C.Count = 0) then Ch := CIns;
  88.     case Ch of
  89.       CNext: C.Next;
  90.       CPrev: C.Prev;
  91.       CEnter: if EditForm then F.Get(C.CardData^);
  92.       CIns:
  93.         begin
  94.           F.Clear;
  95.           F.Show(False);
  96.           if EditForm then
  97.           begin
  98.             C.Insert;
  99.             F.Get(C.CardData^);
  100.           end;
  101.         end;
  102.       CDel:
  103.         if C.Count > 0 then
  104.           if Confirm('Delete this card') then C.Delete;
  105.       CEsc: Stop := True;
  106.     else
  107.       Beep;
  108.     end;
  109.     Start := False;
  110.   until Stop;
  111.   EditCards := Confirm('Update card file');
  112.   NormVideo;
  113.   ClrScr;
  114. end;
  115.  
  116. procedure WriteCards;
  117. begin
  118.   S.Init(ParamStr(1), SCreate, 1024);
  119.   if S.Status <> 0 then Error('Cannot create file');
  120.   S.Write(Signature, SizeOf(Longint));
  121.   F.Store(S);
  122.   C.Store(S);
  123.   S.Flush;
  124.   if S.Status <> 0 then Error('Disk write error');
  125.   S.Done;
  126. end;
  127.  
  128. begin
  129.   if ParamCount <> 1 then
  130.   begin
  131.     WriteLn('Usage: CARDFILE filename');
  132.     Halt(1);
  133.   end;
  134.   ReadCards;
  135.   if EditCards then WriteCards;
  136. end.
  137.